In this report, we reproduce the analyses in the field study 3.

prep data

First, we load the relevant packages, define functions and plotting aesthetics, and load and tidy the data.

load packages

if(!require('pacman')) {
    install.packages('pacman')
}

pacman::p_load(tidyverse, knitr, kableExtra, lmerTest, report, EMAtools, install = TRUE)

define functions

# MLM results table function
table_model = function(model_data, eff_size = FALSE, word_count = TRUE, reversed = FALSE, logistic = FALSE) {

  results = model_data %>%
    broom.mixed::tidy(conf.int = TRUE) %>%
    filter(effect == "fixed") %>%
    rename("SE" = std.error,
           "t" = statistic,
           "p" = p.value) %>%
    select(-group, -effect) %>%
    mutate_at(vars(-contains("term"), -contains("p")), round, 2) %>%
    mutate(term = gsub("article_cond", "", term),
           term = gsub("\\(Intercept\\)", "control", term),
           term = gsub("sharing_type", "sharing type (broadcast)", term),
           term = gsub("msg_rel_self_z", "self-relevance", term),
           term = gsub("msg_rel_social_z", "social relevance", term),
           term = gsub("topichealth", "topic (health)", term),
           term = gsub("n_c", "word count", term),
           term = gsub(":", " x ", term),
           p = ifelse(p < .001, "< .001",
                      ifelse(p == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
           `b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) 
  
  if (word_count == TRUE) {
    results = results %>%
      mutate(term = gsub("control", "intercept", term))
  }

  if (reversed == TRUE) {
    results = results %>%
      mutate(term = gsub("broadcast", "narrowcast", term))
  }
  
  if (eff_size == TRUE) {
    eff_size = lme.dscore(model_data, data = data, type = "lme4") %>%
      rownames_to_column(var = "term") %>%
      mutate(term = gsub("article_cond", "", term),
             term = gsub("article_cond", "", term),
             term = gsub("\\(Intercept\\)", "control", term),
             term = gsub("sharing_type", "sharing type (broadcast)", term),
             term = gsub("msg_rel_self", "self-relevance", term),
             term = gsub("msg_rel_social", "social relevance", term),
             term = gsub("topichealth", "topic (health)", term),
             term = gsub(":", " x ", term),
             d = sprintf("%.2f", d)) %>%
      select(term, d)
    
    results %>%
      left_join(., eff_size) %>%
      mutate(d = ifelse(is.na(d), "--", d)) %>%
      select(term, `b [95% CI]`, d, df, t, p)
    
  } else if (logistic == TRUE) {
    results %>%
      rename("z" = t) %>%
      select(term, `b [95% CI]`, z, p)
    
  } else {
    results %>%
      select(term, `b [95% CI]`, df, t, p)
  }
}

# simple effects function
simple_effects = function(model, sharing = FALSE) {
  if(sharing == FALSE) {
    results = emmeans::contrast(emmeans::emmeans(model, ~ article_cond | group),
                            "revpairwise", by = "group", adjust = "none") %>%
      data.frame() %>%
      filter(grepl("control", contrast)) %>%
      select(contrast, group, estimate, p.value)
  } else {
    results = emmeans::contrast(emmeans::emmeans(model, ~ article_cond | group + sharing_type),
                            "revpairwise", by = "group", adjust = "none") %>%
      data.frame() %>%
      filter(grepl("- control", contrast)) %>%
      filter(!grepl("^control", contrast)) %>%
      extract(contrast, c("exp_sharing", "control_sharing"), ".* (0|1) - control (0|1)", remove = FALSE) %>%
      filter(exp_sharing == control_sharing) %>%
      mutate(sharing_type = ifelse(exp_sharing == 0, "broadcast", "narrowcast"),
             contrast = gsub("0|1", "", contrast)) %>%
      select(contrast, sharing_type, group, estimate, p.value)
  }
  
  results %>%
    mutate(p.value = ifelse(p.value < .001, "< .001",
                      ifelse(p.value == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p.value))))) %>%
    kable(digits = 2) %>%
    kableExtra::kable_styling()
}

define aesthetics

palette_condition = c("self" = "#ee9b00",
                      "control" = "#bb3e03",
                      "other" = "#005f73")
palette_dv = c("self-relevance" = "#ee9b00",
               "social relevance" = "#005f73",
               "sharing" = "#56282D")
palette_topic = c("climate" = "#E6805E",
                 "health" = "#3A3357")

plot_aes = theme_minimal() +
  theme(legend.position = "top",
        legend.text = element_text(size = 12),
        text = element_text(size = 16, family = "Futura Medium"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.text = element_text(color = "black"),
        axis.line = element_line(colour = "black"),
        axis.ticks.y = element_blank())

load data

data = read.csv("../data/study3_data.csv", stringsAsFactors = FALSE) %>%
  group_by(sharing_type) %>%
  mutate(msg_rel_self_z = scale(msg_rel_self, center = TRUE, scale = TRUE),
         msg_rel_social_z = scale(msg_rel_social, center = TRUE, scale = TRUE)) %>%
  filter(sharing_type == 0)

descriptives

Summarize means, SDs, and correlations between the ROIs

ratings

data %>%
  gather(variable, value, msg_share, msg_rel_self, msg_rel_social) %>%
  group_by(variable) %>%
  summarize(M = mean(value, na.rm = TRUE),
            SD = sd(value, na.rm = TRUE)) %>%
  mutate(variable = ifelse(variable == "msg_rel_self", "self-relevance",
                    ifelse(variable == "msg_rel_social", "social relevance", "narrowcast sharing"))) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
variable M SD
self-relevance 57.68 33.64
social relevance 61.45 31.17
narrowcast sharing 34.93 35.30

number of articles

data %>%
  group_by(SID) %>%
  summarize(n = n()) %>%
  ungroup() %>%
  summarize(M = mean(n, na.rm = TRUE),
            SD = sd(n, na.rm = TRUE),
            min = min(n, na.rm = TRUE),
            max = max(n, na.rm = TRUE)) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
M SD min max
8.04 4.67 1 27

sharing intentions

H2

Do the manipulations increase relevance?

self-relevance

✅ H2a: Self-focused intervention (compared to control) will increase self-relevance

mod_h2a = lmer(msg_rel_self ~ 1 + article_cond + (1 | SID),
              data = data,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h2a = table_model(mod_h2a)

table_h2a %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 55.76 [53.31, 58.20] 867.69 44.80 < .001
other 1.22 [-1.18, 3.62] 2955.56 1.00 .319
self 7.97 [5.56, 10.38] 2954.06 6.48 < .001

summary

summary(mod_h2a)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_self ~ 1 + article_cond + (1 | SID)
##    Data: data
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 32221.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.8618 -0.7311  0.1787  0.7083  2.5941 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 302.3    17.39   
##  Residual             816.9    28.58   
## Number of obs: 3321, groups:  SID, 413
## 
## Fixed effects:
##                   Estimate Std. Error       df t value             Pr(>|t|)    
## (Intercept)         55.756      1.244  867.689  44.802 < 0.0000000000000002 ***
## article_condother    1.221      1.226 2955.562   0.996                0.319    
## article_condself     7.965      1.229 2954.056   6.481       0.000000000107 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) artcl_cndt
## artcl_cndth -0.501           
## artcl_cndsl -0.500  0.507

social relevance

✅ H2b: Other-focused intervention (compared to control) will increase social relevance

mod_h2b = lmer(msg_rel_social ~ 1 + article_cond + (1 | SID),
              data = data,
              control = lmerControl(optimizer = "bobyqa"))

model summary table

table_h2b = table_model(mod_h2b)

table_h2b %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 59.38 [57.06, 61.71] 800.53 50.15 < .001
other 5.37 [3.20, 7.54] 2949.23 4.86 < .001
self 4.26 [2.08, 6.43] 2947.79 3.84 < .001

summary

summary(mod_h2b)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_rel_social ~ 1 + article_cond + (1 | SID)
##    Data: data
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 31594.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.2458 -0.6124  0.1844  0.6512  2.8278 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 303.8    17.43   
##  Residual             663.3    25.75   
## Number of obs: 3321, groups:  SID, 413
## 
## Fixed effects:
##                   Estimate Std. Error       df t value             Pr(>|t|)    
## (Intercept)         59.383      1.184  800.532  50.151 < 0.0000000000000002 ***
## article_condother    5.370      1.105 2949.234   4.861           0.00000123 ***
## article_condself     4.257      1.108 2947.785   3.842             0.000125 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) artcl_cndt
## artcl_cndth -0.475           
## artcl_cndsl -0.473  0.507

combined plot

predicted_h2 = ggeffects::ggpredict(mod_h2a, c("article_cond")) %>%
  data.frame() %>%
  mutate(model = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h2b, c("article_cond")) %>%
              data.frame() %>%
              mutate(model = "social relevance")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

predicted_sub_h2 = ggeffects::ggpredict(mod_h2a, terms = c("article_cond", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(model = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h2b, c("article_cond", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(model = "social relevance")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))
  
predicted_h2 %>%
  ggplot(aes(x = x, y = predicted)) +
  stat_summary(data = predicted_sub_h2, aes(group = group), fun = "mean", geom = "line",
               size = .08, color = "grey50") +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
  geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = .5) +
  facet_grid(~model) +
  scale_color_manual(name = "", values = palette_condition, guide = "none") +
  scale_alpha_manual(name = "", values = c(1, .5)) +
  labs(x = "", y = "predicted rating\n") +
  plot_aes +
  theme(legend.position = c(.85, .15))
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

H3

Is greater self and social relevance associated with higher sharing intentions?

✅ H1a: Greater self-relevance ratings will be associated with higher narrowcast sharing intentions

✅ H1a: Greater social relevance ratings will be associated with higher narrowcast sharing intentions

mod_h3 = lmer(msg_share ~ msg_rel_self_z + msg_rel_social_z + (1 + msg_rel_social_z | SID),
              data = data,
              control = lmerControl(optimizer = "bobyqa"))

plot

predicted_h3 = ggeffects::ggpredict(mod_h3, c("msg_rel_self_z")) %>%
  data.frame() %>%
  mutate(variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h3, c("msg_rel_social_z")) %>%
              data.frame() %>%
              mutate(variable = "social relevance"))

predicted_sub_h3 = ggeffects::ggpredict(mod_h3, terms = c("msg_rel_self_z", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h3, c("msg_rel_social_z", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(variable = "social relevance"))

(plot_h3 = predicted_h3 %>%
  ggplot(aes(x, predicted)) +
  stat_smooth(data = predicted_sub_h3, aes(group = group, color = variable),
              geom ='line', method = "lm", alpha = .05, linewidth = .75, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high, fill = variable), alpha = .5, color = NA) +
  geom_line(aes(color = variable), size = 1.5) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_dv) +
  scale_fill_manual(name = "", values = palette_dv) +
  labs(x = "\nrelevance rating (SD)", y = "predicted sharing intention rating\n") +
  plot_aes +
    theme(legend.position = "none"))

model table

table_h3 = table_model(mod_h3)

table_h3 %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 33.87 [31.66, 36.07] 403.86 30.18 < .001
self-relevance 3.11 [2.01, 4.21] 3015.96 5.55 < .001
social relevance 14.19 [12.75, 15.62] 851.19 19.43 < .001

summary

summary(mod_h3)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## msg_share ~ msg_rel_self_z + msg_rel_social_z + (1 + msg_rel_social_z |  
##     SID)
##    Data: data
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 29883.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7558 -0.4470 -0.0524  0.3619  4.9547 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr
##  SID      (Intercept)      458.68   21.417       
##           msg_rel_social_z  83.95    9.162   0.99
##  Residual                  350.30   18.716       
## Number of obs: 3321, groups:  SID, 413
## 
## Fixed effects:
##                   Estimate Std. Error        df t value             Pr(>|t|)
## (Intercept)        33.8654     1.1222  403.8636  30.177 < 0.0000000000000002
## msg_rel_self_z      3.1082     0.5598 3015.9594   5.553         0.0000000305
## msg_rel_social_z   14.1876     0.7300  851.1861  19.435 < 0.0000000000000002
##                     
## (Intercept)      ***
## msg_rel_self_z   ***
## msg_rel_social_z ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) msg_rl_sl_
## msg_rl_slf_  0.001           
## msg_rl_scl_  0.607 -0.573

H5

Do the manipulations increase sharing intentions?

Here we focus on narrowcasting only since that is the type of sharing we used in fMRI study 1.

✅ H5: Self-focused intervention (compared to control) will increase sharing intentions

✅ H5: Other-focused intervention (compared to control) will increase sharing intentions

mod_h5 = lmer(msg_share ~ 1 + article_cond + (1 | SID),
              data = data,
              control = lmerControl(optimizer = "bobyqa"))

plot

predicted_h5 = ggeffects::ggpredict(mod_h5, c("article_cond")) %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))
  
predicted_sub_h5 = ggeffects::ggpredict(mod_h5, terms = c("article_cond", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

predicted_h5 %>%
  ggplot(aes(x = x, y = predicted)) +
  stat_summary(data = predicted_sub_h5, aes(group = group), fun = "mean", geom = "line",
               size = .08, color = "grey50") +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
  geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = .5) +
  scale_color_manual(name = "", values = palette_condition, guide = "none") +
  scale_alpha_manual(name = "", values = c(1, .5)) +
  labs(x = "", y = "predicted rating\n") +
  plot_aes

model table

table_h5 = table_model(mod_h5)

table_h5 %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 33.80 [30.80, 36.79] 557.78 22.17 < .001
other 3.94 [1.98, 5.90] 2919.71 3.94 < .001
self 3.19 [1.22, 5.15] 2918.65 3.18 .001

summary

summary(mod_h5)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: msg_share ~ 1 + article_cond + (1 | SID)
##    Data: data
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 31284.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.5557 -0.5286 -0.1252  0.5088  3.7187 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  SID      (Intercept) 731.2    27.04   
##  Residual             540.3    23.25   
## Number of obs: 3321, groups:  SID, 413
## 
## Fixed effects:
##                    Estimate Std. Error        df t value             Pr(>|t|)
## (Intercept)         33.7963     1.5245  557.7844  22.169 < 0.0000000000000002
## article_condother    3.9393     0.9991 2919.7077   3.943            0.0000824
## article_condself     3.1867     1.0019 2918.6534   3.181              0.00148
##                      
## (Intercept)       ***
## article_condother ***
## article_condself  ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) artcl_cndt
## artcl_cndth -0.334           
## artcl_cndsl -0.333  0.507

combined plot

plot_condition = predicted_h2 %>%
  bind_rows(predicted_h5 %>% mutate(model = "sharing intention")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         model = factor(model, levels = c("sharing intention", "social relevance", "self-relevance"))) %>%
  ggplot(aes(x = model, y = predicted, color = x)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high), position = position_dodge(.5), size = 1) +
  coord_flip() +
  scale_color_manual(name = "", values = palette_condition) +
  labs(x = "", y = "predicted rating\n") +
  plot_aes +
  theme(legend.position = c(.15, .9))

cowplot::plot_grid(plot_condition, plot_h3, ncol = 1, labels = c("A", "B"))

combined table

table_h2a %>% mutate(DV = "H2a: Self-relevance") %>%
  bind_rows(table_h2b %>% mutate(DV = "H2b: Social relevance")) %>%
  bind_rows(table_h3 %>% mutate(DV = "H3a-b: Sharing intention")) %>%
  bind_rows(table_h5 %>% mutate(DV = "H5: Sharing intention")) %>%
  select(DV, everything()) %>%
  kable() %>%
  kable_styling()
DV term b [95% CI] df t p
H2a: Self-relevance intercept 55.76 [53.31, 58.20] 867.69 44.80 < .001
H2a: Self-relevance other 1.22 [-1.18, 3.62] 2955.56 1.00 .319
H2a: Self-relevance self 7.97 [5.56, 10.38] 2954.06 6.48 < .001
H2b: Social relevance intercept 59.38 [57.06, 61.71] 800.53 50.15 < .001
H2b: Social relevance other 5.37 [3.20, 7.54] 2949.23 4.86 < .001
H2b: Social relevance self 4.26 [2.08, 6.43] 2947.79 3.84 < .001
H3a-b: Sharing intention intercept 33.87 [31.66, 36.07] 403.86 30.18 < .001
H3a-b: Sharing intention self-relevance 3.11 [2.01, 4.21] 3015.96 5.55 < .001
H3a-b: Sharing intention social relevance 14.19 [12.75, 15.62] 851.19 19.43 < .001
H5: Sharing intention intercept 33.80 [30.80, 36.79] 557.78 22.17 < .001
H5: Sharing intention other 3.94 [1.98, 5.90] 2919.71 3.94 < .001
H5: Sharing intention self 3.19 [1.22, 5.15] 2918.65 3.18 .001

sharing behavior

descriptives

percent sharing

data %>%
  filter(sharing_type == 0) %>%
  group_by(LiveShare) %>%
  summarize(n = n()) %>%
  ungroup() %>%
  mutate(total = sum(n),
         percent = (n / total) * 100) %>%
  select(-total) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
LiveShare n percent
0 3287 98.98
1 34 1.02

number of shares per person

data %>%
  filter(sharing_type == 0) %>%
  group_by(SID) %>%
  mutate(n_shares = sum(LiveShare, na.rm = TRUE)) %>%
  ggplot(aes(n_shares)) +
  geom_density(fill = palette_condition[1], color = NA) +
  labs(x = "\nnumber of shares per person") +
  plot_aes

correlation between sharing intentions and sharing behavior

data %>%
  ungroup() %>%
  select(-sharing_type) %>%
  spread(sharing_type_key, msg_share) %>%
  rmcorr::rmcorr(as.factor(SID), LiveShare, msg_share_narrow, data = .)
## 
## Repeated measures correlation
## 
## r
## 0.08280991
## 
## degrees of freedom
## 2907
## 
## p-value
## 0.00000774452
## 
## 95% confidence interval
## 0.04659567 0.1188068

H3

Is greater self and social relevance associated with higher sharing intentions?

mod_h3_binary = glmer(LiveShare ~ msg_rel_self_z + msg_rel_social_z + (1 | SID),
              data = filter(data, sharing_type == 0),
              family = "binomial",
              control = glmerControl(optimizer = "bobyqa"))

plot

predicted_h3_binary = ggeffects::ggpredict(mod_h3_binary, c("msg_rel_self_z")) %>%
  data.frame() %>%
  mutate(variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h3_binary, c("msg_rel_social_z")) %>%
              data.frame() %>%
              mutate(variable = "social relevance"))

predicted_sub_h3_binary = ggeffects::ggpredict(mod_h3_binary, terms = c("msg_rel_self_z", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h3_binary, c("msg_rel_social_z", "SID"), type = "random") %>%
              data.frame() %>%
              mutate(variable = "social relevance"))

predicted_h3_binary %>%
  ggplot(aes(x, predicted)) +
  stat_smooth(data = predicted_sub_h3_binary, aes(group = group, color = variable),
              geom ='line', method = "lm", alpha = .1, linewidth = .75, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high, fill = variable), alpha = .5, color = NA) +
  geom_line(aes(color = variable), size = 1.5) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_dv) +
  scale_fill_manual(name = "", values = palette_dv) +
  labs(x = "\nrelevance rating", y = "predicted probability of sharing\n") +
  plot_aes +
    theme(legend.position = "none")

model table

table_h3_binary = table_model(mod_h3_binary, logistic = TRUE)

table_h3_binary %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] z p
intercept -10.82 [-12.84, -8.79] -10.47 < .001
self-relevance 0.04 [-0.68, 0.76] 0.11 .914
social relevance 1.01 [0.06, 1.96] 2.08 .038

summary

summary(mod_h3_binary)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: LiveShare ~ msg_rel_self_z + msg_rel_social_z + (1 | SID)
##    Data: filter(data, sharing_type == 0)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##    253.7    278.2   -122.9    245.7     3317 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.0529 -0.0071 -0.0051 -0.0031  9.1816 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  SID    (Intercept) 62.89    7.93    
## Number of obs: 3321, groups:  SID, 413
## 
## Fixed effects:
##                   Estimate Std. Error z value            Pr(>|z|)    
## (Intercept)      -10.81776    1.03285 -10.474 <0.0000000000000002 ***
## msg_rel_self_z     0.03994    0.36924   0.108              0.9139    
## msg_rel_social_z   1.00903    0.48512   2.080              0.0375 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) msg_rl_sl_
## msg_rl_slf_  0.042           
## msg_rl_scl_ -0.277 -0.625

H5

Do the manipulations increase sharing intentions?

Here we focus on narrowcasting only since that is the type of sharing we used in fMRI study 1.

mod_h5_binary = glmer(LiveShare ~ 1 + article_cond + (1 | SID),
              data = filter(data, sharing_type == 0),
              family = "binomial",
              control = glmerControl(optimizer = "bobyqa"))

plot

predicted_h5_binary = ggeffects::ggpredict(mod_h5_binary, c("article_cond")) %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))
  
predicted_sub_h5_binary = ggeffects::ggpredict(mod_h5_binary, terms = c("article_cond", "SID"), type = "random") %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

predicted_h5_binary %>%
  ggplot(aes(x = x, y = predicted)) +
  stat_summary(data = predicted_sub_h5_binary, aes(group = group), fun = "mean", geom = "line",
               size = .08, color = "grey50") +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
  geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = .5) +
  scale_color_manual(name = "", values = palette_condition, guide = "none") +
  scale_alpha_manual(name = "", values = c(1, .5)) +
  labs(x = "", y = "predicted probability of sharing\n") +
  plot_aes

model table

table_h5_binary = table_model(mod_h5_binary, logistic = TRUE)

table_h5_binary %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] z p
intercept -11.30 [-13.47, -9.12] -10.18 < .001
other 0.71 [-0.54, 1.97] 1.11 .267
self 1.45 [0.25, 2.65] 2.36 .018

summary

summary(mod_h5_binary)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: LiveShare ~ 1 + article_cond + (1 | SID)
##    Data: filter(data, sharing_type == 0)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##    256.6    281.1   -124.3    248.6     3317 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.3058 -0.0072 -0.0050 -0.0035  4.6930 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  SID    (Intercept) 62.78    7.924   
## Number of obs: 3321, groups:  SID, 413
## 
## Fixed effects:
##                   Estimate Std. Error z value            Pr(>|z|)    
## (Intercept)       -11.2967     1.1092 -10.184 <0.0000000000000002 ***
## article_condother   0.7108     0.6404   1.110              0.2670    
## article_condself    1.4467     0.6121   2.364              0.0181 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) artcl_cndt
## artcl_cndth -0.388           
## artcl_cndsl -0.464  0.650

combined table

table_h3_binary %>% mutate(DV = "H3a-b: Sharing") %>%
  bind_rows(table_h5_binary %>% mutate(DV = "H5: Sharing")) %>%
  select(DV, everything()) %>%
  kable() %>%
  kable_styling()
DV term b [95% CI] z p
H3a-b: Sharing intercept -10.82 [-12.84, -8.79] -10.47 < .001
H3a-b: Sharing self-relevance 0.04 [-0.68, 0.76] 0.11 .914
H3a-b: Sharing social relevance 1.01 [0.06, 1.96] 2.08 .038
H5: Sharing intercept -11.30 [-13.47, -9.12] -10.18 < .001
H5: Sharing other 0.71 [-0.54, 1.97] 1.11 .267
H5: Sharing self 1.45 [0.25, 2.65] 2.36 .018

cite packages

report::cite_packages()
##   - Douglas Bates, Martin Maechler and Mikael Jagan (2023). Matrix: Sparse and Dense Matrix Classes and Methods. R package version 1.5-4. https://CRAN.R-project.org/package=Matrix
##   - Douglas Bates, Martin Maechler, Ben Bolker, Steve Walker (2015). Fitting Linear Mixed-Effects Models Using lme4. Journal of Statistical Software, 67(1), 1-48. doi:10.18637/jss.v067.i01.
##   - Evan Kleiman (2021). EMAtools: Data Management Tools for Real-Time Monitoring/Ecological Momentary Assessment Data. R package version 0.1.4. https://CRAN.R-project.org/package=EMAtools
##   - H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016.
##   - Hadley Wickham (2021). forcats: Tools for Working with Categorical Variables (Factors). R package version 0.5.1. https://CRAN.R-project.org/package=forcats
##   - Hadley Wickham (2022). stringr: Simple, Consistent Wrappers for Common String Operations. R package version 1.5.0. https://CRAN.R-project.org/package=stringr
##   - Hadley Wickham and Maximilian Girlich (2022). tidyr: Tidy Messy Data. R package version 1.2.0. https://CRAN.R-project.org/package=tidyr
##   - Hadley Wickham, Jim Hester and Jennifer Bryan (2022). readr: Read Rectangular Text Data. R package version 2.1.2. https://CRAN.R-project.org/package=readr
##   - Hadley Wickham, Romain François, Lionel Henry and Kirill Müller (2022). dplyr: A Grammar of Data Manipulation. R package version 1.0.9. https://CRAN.R-project.org/package=dplyr
##   - Hao Zhu (2021). kableExtra: Construct Complex Table with 'kable' and Pipe Syntax. R package version 1.3.4. https://CRAN.R-project.org/package=kableExtra
##   - Kirill Müller and Hadley Wickham (2022). tibble: Simple Data Frames. R package version 3.1.8. https://CRAN.R-project.org/package=tibble
##   - Kuznetsova A, Brockhoff PB, Christensen RHB (2017). "lmerTest Package:Tests in Linear Mixed Effects Models." _Journal of StatisticalSoftware_, *82*(13), 1-26. doi: 10.18637/jss.v082.i13 (URL:https://doi.org/10.18637/jss.v082.i13).
##   - Lionel Henry and Hadley Wickham (2020). purrr: Functional Programming Tools. R package version 0.3.4. https://CRAN.R-project.org/package=purrr
##   - Makowski, D., Ben-Shachar, M.S., Patil, I. & Lüdecke, D. (2020). Automated Results Reporting as a Practical Tool to Improve Reproducibility and Methodological Best Practices Adoption. CRAN. Available from https://github.com/easystats/report. doi: .
##   - R Core Team (2021). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
##   - Rinker, T. W. & Kurkiewicz, D. (2017). pacman: Package Management for R. version 0.5.0. Buffalo, New York. http://github.com/trinker/pacman
##   - Wickham et al., (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686, https://doi.org/10.21105/joss.01686
##   - Yihui Xie (2021). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.37.